perm filename JSTIFY.F4[NEW,LCS] blob
sn#319868 filedate 1977-11-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C****** MOVER, MVBEAM, MVBX, RTLINE, EXTEN, CLEFS
C00014 ENDMK
C⊗;
C****** MOVER, MVBEAM, MVBX, RTLINE, EXTEN, CLEFS
SUBROUTINE MOVER
IMPLICIT INTEGER(A-Q,S-Z)
DIMENSION IR(2,200)
REAL POS,EXTEN,PRCNT,ACCX
COMMON/RINP/R(2,200),NO(250),NP(250)
COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/STF/RSTFAC(0/7),RSTJ2
COMMON/XRN/RN(2000) /KJY/ KY,JY
COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
COMMON/POSI/STFF(0/7),JJ2,POS/PTR/PWDS(250),ITEM,LL,I,IX
COMMON/ALF/INP(46),ACCX,ML,RRT,RZRO,RCNT,RJSZ,ROV,RSPC,KN,RA,RB,
1 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,RV,RQ6
EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(R11,RJQ(9))
1,(IR,R)
DATA F78F/'(78F)'/,FA1/'(A1 )'/,FA5/'(A5 )'/,RSP/.5/,RI/4.5/
JJ2=999
J2=0
ASK=-1
C 99=BACKUP
6 CALL VLINE(R2,R4,R5,R6)
IF(R2.GE.99)RETURN
IF(INP(1).EQ.'J')GO TO 12
167 TYPE 5
ACCEPT F78F,R7,R8,R9,R11
IF(R7.GE.99)GO TO 6
IF(R2.LE.7.AND.R7.GT.7)GO TO 167
C TRY AGAIN IF CONFUSION.
RDIS=0
REREAD FA1,L
C FOR LPEN TYPE 'L'. BUT 4TH # MUST APPEAR WHEN NEEDED.
IF(L.EQ.'B')GO TO 6
IF(R2.GT.7)R7=R2
IF(R7.NE.R2)TYPE 1200,R7
1201 IF(L.NE.'L')GO TO 66
DO 67 K=1,2
R8=RY
CALL LPEN(R7,RY,RX)
67 IF(R7.GE.99)GO TO 6
R9=RY
CC66 JJ2=1
66 NST=1
C FOR START OF LOOP (1 UNLESS USING COPYIT)
IF(INP(1).NE.'C')GO TO 68
NST=ITEM+1
CALL COPYIT
68 IF(R11.NE.0)CALL UPDN(NST)
JJ=0
IF(R4.NE.R8.OR.R5.NE.R9)JJ=-1
JY=0
C JY IS CHANGED IN GETPTS
IF(JJ)CALL GETPTS(NST)
IF(R2.NE.R7)CALL STFCH
IF(JY.NE.0)GO TO 1
7 IF(JJ2.EQ.999)JJ2=-1
RETURN
CC IF(JY.EQ.0)RETURN
1 CALL MOVIT
RETURN
12 IF(R4.EQ.0)R4=.001
IF(R5.EQ.0)R5=200
RCNT=0
RRT=R5
RZRO=R4
RJSZ=RI
CALL GETPTS(1)
IF(JY.EQ.0)GO TO 7
C RETURN IF NO ITEMS FOUND TO DEAL WITH.
ROV=RRT
PRCNT=1.
R7=R2
R6=0
R11=0
19 IF(RCNT.GT.9)GO TO 101
RJSZ=RJSZ-.06
RP=PRCNT
RCNT=RCNT+1
C TEMPORARY COUNTER
TYPE F78F,RCNT
DO 11 KN=0,7
RSPC=0
R8=KN
N=0
DO 2 K=1,KY
L=NP(K)
RL=RN(L)
RA=RN(L+1)
RB=RN(L+3)
IF(RN(L+2).EQ.R8)GO TO 77
C THIS STAFF?
IF(RA.NE.4)GO TO 2
C SKIPS HOMED NOTES (IN CHORDS)
CC77 IF(RA.EQ.1)GO TO 10
CC27 IF(RA.LE.4)GO TO 177
77 IF(RA.LT.3)GO TO 10
IF(RA.EQ.4)GO TO 444
IF(RA.EQ.3)GO TO 333
C LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
IF(RA.LT.17)GO TO 2
GO TO 10
333 IF(RL.LT.3)GO TO 10
C <3 MEANS NOTHING IN P5
IF(RN(L+5).GT.4)GO TO 2
C NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
GO TO 10
444 IF(RL.GT.3)GO TO 2
CC FOR REPEATE BAR WDCNT IS 3 -- 10/77 444 IF(RL.GT.2)GO TO 2
C SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
10 N=N+1
R(1,N)=RB
IR(2,N)=L
IF(N.EQ.200)GO TO 28
C ONLY TREATS 200 ITEMS AT A TIME.
2 CONTINUE
IF(N.EQ.0)GO TO 11
28 DO 23 K=1,N
23 IF(RN(IR(2,K)+1).NE.4)GO TO 24
C SKIPS IF ONLY BAR LINES ON THIS STAFF
GO TO 11
24 RSTJ2=RSTFAC(KN)*PRCNT
CALL SORT2(R,N)
C JUMP IF LAST IS A BAR LINE.
K=0
JLDGR=0
JX=0
22 K=K+1
122 L=IR(2,K)
RA=RN(L+1)
C RA IS NOW CODE NUM.
RB=0
RD=0
C RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
RX=RN(L+5)
C RX=PARAM 5
RX6=RN(L+6)
RY=1
RW=AMOD(RN(L+4),100.)
IF(RA.GT.1)GO TO 4
RZ=RN(L+7)
IF(LDGR.NE.JLDGR)JLDGR=0
LDGR=0
JK=K
DO 32 JJ=JK+1,N+1
K=JJ
RB=R(1,JJ)-R(1,JJ-1)
IF(RB.GT.0.1)GO TO 320
C PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
R(1,JJ)=R(1,JJ-1)
GO TO 32
320 IF(RB.GT.RSP)GO TO 35
32 CONTINUE
C FOUND HOW MANY MEMBERS TO CHORD.
35 RB=0
K=K-1
RQ=0
CC125 IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
125 RC=ABS(RN(L+4))
IF(RC.LT.60)GO TO 137
IF(RC.LT.180)RY=.6
C FOUND A MINI-NOTE
137 DO 37 JJ=JK,K-1
IF(RD.NE.0)GO TO 38
C FINDS ONLY HIGH OR! LOW LED. LINE.
JR=IR(2,JJ)
RW=AMOD(RN(JR+4),100.)
IF(RW.GT.12)GO TO 277
IF(RW.GE.2)GO TO 38
277 LDGR=-1
IF(RW.GT.11)LDGR=1
IF(JLDGR.EQ.LDGR)GO TO 36
JLDGR=LDGR
C LDGR IS FOR LEDGER LINES.
GO TO 38
36 RD=1.5
RQ=RD
38 IF(RB.GT.2)GO TO 222
C JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
RZZ=RN(JR+7)
RE=RN(JR+5)
CC IF(RB.LT.2.AND.((AMOD(RZZ,10.).NE.0.AND.RE.LT.20).
CC 1 OR.RZZ.GE.10))RB=1.5+EXTEN(RZZ)
IF(RB.GE.2)GO TO 477
RC=1.5
IF(RZZ.LT.10)GO TO 378
IF(RZZ.GE.20)RC=3.
C 10=DOT, 20=DOUBLE DOT
GO TO 377
378 IF(RE.GE.20)GO TO 477
IF(AMOD(RZZ,10.).EQ.0)GO TO 477
377 RB=RC+EXTEN(RZZ)
C SPACE FOR DOT OR TAIL(IF STEM UP)
477 IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
C FOR CHORD TONES ON RIGHT OF STEM UP.
C LOOKS THROUGH ALL NOTES OF A CHORD.
222 IF(AMOD(RE,10.).EQ.0)GO TO 37
C JUMP IF NO ACCIS.
425 RD=2.8*RY+EXTEN(RE)
CGHB USE 2.8 FOR SIZE OF ACCIS (THEY'RE REALLY 3)425 RD=2*RY+EXTEN(RE)
IF(RQ.GT.RD)RD=RQ
RQ=RD
C FUNCT. EXTEN=AMOD(X,1.)*10.
37 CONTINUE
IF(RY.NE.1)RB=RB-.5*RJSZ
C MINI NOTES NEED LESS SPACE
250 ACCX=0
RC=0
RW=R(1,JX+1)
DO 132 JJ=JX+1,N
IF(RW.NE.R(1,JJ))GO TO 25
KX=IR(2,JJ)
C GET POINTER
IF(RN(KX+1).NE.1)GO TO 25
C ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
RE=ABS(RN(KX+6))
IF(RE.GE.10)RC=-2.6
IF(RE.EQ.20)RC=-RC
CC 2/25/76 IF(ABS(RN(KX+6)).GE.20)RC=2.6
RE=AMOD(RN(KX+5),10.0)
C FIND AN ACCI
CCCCC IF(RE.EQ.0)GO TO 132
IF(RE.GE.1)RC=RC+2
C FOUND AN ACCI
CC ***** WHY WAS THIS *10????? RC=AMOD(RE,1.0)*10.0+RC
RC=AMOD(RE,1.0)*10.0+RC
C ADD ANY EXTENSION TO THE LEFT
IF(RC.GT.ACCX)ACCX=RC
RC=0
IF(ACCX.GT.RD)RD=ACCX
132 CONTINUE
25 IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
GO TO 17
4 IF(RA.NE.2)GO TO 33
C NEXT FOR DOTTED RESTS - IN P6
IF(RN(L).GE.4)RB=RN(L+6)*1.5
C NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
GO TO 250
33 IF(RA.NE.3)GO TO 29
RB=3
IF(RN(L+4).GT.80)RB=1.5
C CHECK ON SIZE NEEDED FOR CLEFS. >80 = MINICLEF
29 IF(RA.NE.4)GO TO 26
RB=-RJSZ/(2*RSTJ2)
CGHB RB=-RJSZ/2
RD=.9
GO TO 25
26 IF(RA.NE.18)GO TO 30
RB=-1
RD=1
IF(RX6.LE.9.AND.RX.LE.9)GO TO 25
CC IF(RX.GT.9)GO TO 31
C CHECKS FOR 2-DIGIT METERS
RD=2
RB=0
GO TO 25
CC31 RB=2
CC RD=3
30 IF(RA.NE.17)GO TO 17
RX=ABS(RX)
IF(RX.GE.100)RX=RX-100
C +100 FOR NATURALS AS KEYSIG.
RB=2*(RX-1)-2
CC RB=2*(ABS(RX)-1)-2
C SPACES FOR CORRECT NUM OF ACCIS. RX=NUM OF ACCIS.
RD=2
GO TO 25
C ↑↑↑↑↑ TO RESET AFTER CHORD NOTES 12/75
17 RC=(RB+RJSZ)*RSTJ2
C RJSZ=DEFAULT SIZE
JX=K
R(2,JX)=RC
CC??????? R(1,JX)=R(1,K)
3 IF(K.LT.N)GO TO 22
RA=R(1,1)
RB=R(2,1)
DO 13 KX=2,JX
RE=R(1,KX)
C POS. BEFORE SHIFTING
IF(ABS(RE-RA).GT..5)GO TO 14
IF(R(2,KX).GT.RB)GO TO 16
C SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
GO TO 13
C JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
14 RD=RA+RB-RE
IF(RD.LE.0)GO TO 16
C THERE'S ENOUGH ROOM
ROV=ROV+RD
140 R4=RE+RSPC-.001
R5=10000
R8=RD
R9=0
C GO EXPAND IT
IF(R(2,KX).EQ.0)GO TO 15
CALL MOVIT
C???? IF(R2.LE.4)GO TO 15
IF(R2.LE.7)GO TO 15
R5=R4
R4=RA+.001+RSPC
R8=R4
R9=R5+RD-.001
C FOR ITEMS ON OTHER LINES.
CALL MOVIT
15 RSPC=RSPC+RD
C RSPC SAVES TOTAL SPACE ADDED
16 RB=R(2,KX)
13 RA=RE
11 CONTINUE
110 IF(ROV.LE.RRT+.01)RETURN
IF(RJSZ.GT.4)RJSZ=4
PRCNT=(ROV-RZRO)/(RRT-RZRO)
IF(PRCNT.NE.RP)GO TO 19
C GO BACK AND EXPAND SOME MORE
101 R4=RZRO
R5=ROV
R8=RZRO
R9=RRT-.001
C JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
CALL MOVIT
C RVX SHOULD BE FARTHEST POINT TO RIGHT.
1200 FORMAT(' MOVED TO STAFF ',F4.0/)
CALL HYDPOG(3)
5 FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN # '$)
END